home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tpu60.arc / TPU6.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-01  |  46KB  |  1,399 lines
  1. {$D+,L+,S+,R-,E-,N-}
  2. PROGRAM TPU6;
  3. USES TPU6AMS,TPU6REF,TPU6RPT,TPU6UNA,Dos,Crt;
  4.  
  5. TYPE
  6.    MethodName = String[127];
  7.    HeadProc   = PROCEDURE;
  8. VAR
  9.    CSegOrg,    CSegEnd,     NextLL,    LastLL        : Word;
  10.  
  11.    TabStop,    NoteX,         NoteY                    : Integer;
  12.  
  13.    NoteTime     : LongInt;
  14.    DisAssembly    : Boolean;
  15.    SurveyWork   : SurveyRec;
  16.    Map          : MapRefRec;
  17.  
  18. PROCEDURE NoteBegin(S:String);                                  {.CP08}
  19. VAR HH,MM,SS,CS : Word;
  20. BEGIN
  21.     NoteX := WhereX; NoteY := WhereY; ClrEol;
  22.     GetTime(HH,MM,SS,CS);
  23.     NoteTime := ((HH*60+MM)*60+SS)*100+CS;
  24.     Write(S);
  25. END;
  26.  
  27. PROCEDURE PageOverFlow(Lines : Word; CallProc : HeadProc);      {.CP09}
  28. BEGIN
  29.     IF LinesRemaining < Lines THEN
  30.     BEGIN
  31.         NewTxtPage;
  32.         CallProc;
  33.     END
  34.     ELSE    NewTxtLine;
  35. END;
  36.  
  37. PROCEDURE NoteEnd;                        {.CP11}
  38. VAR HH,MM,SS,CS : Word; SF : String[3];  I : Integer;
  39. BEGIN
  40.     GetTime(HH,MM,SS,CS);
  41.     NoteTime := (((HH*60+MM)*60+SS)*100+CS) - NoteTime;
  42.         Str(NoteTime MOD 100 + 100:3,SF);
  43.         I := NoteTime DIV 100;
  44.     Write(', Finished in ',I:5,'.',Copy(SF,2,2),' seconds');
  45.     Delay(1000);
  46.     GoToXY(NoteX,NoteY);
  47. END;
  48.  
  49. PROCEDURE PrintTitleBlk(S : String; LinesNeeded : Integer);    {.CP11}
  50. BEGIN {PrintTitleBlk}
  51.     IF LinesRemaining < LinesNeeded+3
  52.         THEN NewTxtPage    ELSE SetCol(1);
  53.     PutTxt('-------------');
  54.     NewTxtLine;
  55.     PutTxt('- ' + S);
  56.     NewTxtLine;
  57.     PutTxt('-------------');
  58.     SetCol(1);
  59. END; {PrintTitleBlk}
  60.  
  61. PROCEDURE PrintAddress(Arg : LL);                {.CP06}
  62. BEGIN
  63.     IF ColumnsUsed <> 0 THEN NewTxtLine;
  64.     PutTxt(HexW(Arg));
  65.     SetCol(7);
  66. END; {PrintAddress}
  67.  
  68. PROCEDURE PrintByteList(U : UnitPtr; Count, Space : Word);    {.CP11}
  69. BEGIN
  70.     WITH BufPtr(U)^ DO
  71.     WHILE Count > 0 DO
  72.     BEGIN
  73.         PutTxt(HexB(BufByt[NextLL]));
  74.         SetCol(ColumnsUsed+Space+1);
  75.         Inc(NextLL);
  76.         Dec(Count);
  77.     END
  78. END; {PrintByteList}
  79.  
  80. PROCEDURE PrintWd(U : UnitPtr; S : String);            {.CP07}
  81. BEGIN
  82.     PrintAddress(NextLL);
  83.     PrintByteList(U,2,1);
  84.     SetCol(TabStop);
  85.     PutTxt(S);
  86. END; {PrintWd}
  87.  
  88. PROCEDURE PrintLL(U : UnitPtr; S : String);            {.CP07}
  89. BEGIN
  90.     PrintAddress(NextLL);
  91.     PrintByteList(U,2,1);
  92.     SetCol(TabStop);
  93.     PutTxt('LL('+S+')');
  94. END; {PrintLL}
  95.  
  96. FUNCTION NilLG(U : UnitPtr; Locn : LL) : Boolean;        {.CP08}
  97. VAR L : ^LG;
  98. BEGIN
  99.     L := Ptr(Seg(U^),Ofs(U^)+Locn);            {Get Ptr to LG}
  100.     IF (L^.UntLL = 0) AND (L^.UntId = 0)
  101.     THEN NilLG := True
  102.     ELSE NilLG := False
  103. END;
  104.  
  105. PROCEDURE PrintLG(U : UnitPtr; S : String);            {.CP15}
  106. VAR L : ^LG; V : DNamePtr;
  107. BEGIN
  108.     IF NOT NilLG(U,NextLL) THEN
  109.     BEGIN
  110.         L := Ptr(Seg(U^),Ofs(U^)+NextLL); {Get Ptr to LG}
  111.         V := AddrLGUnit(U,L^);
  112.         IF V <> Nil THEN S := S + ' in "'+V^.DSymb+'" unit';
  113.         S := 'LG('+S+')';
  114.     END;
  115.     PrintAddress(NextLL);
  116.     PrintByteList(U,4,1);
  117.     SetCol(TabStop);
  118.     PutTxt(S);
  119. END; {PrintLG}
  120.  
  121. PROCEDURE PrintSoloByte(U : UnitPtr; S : String);        {.CP08}
  122. VAR B : Byte;
  123. BEGIN
  124.     PrintAddress(NextLL);
  125.     PrintByteList(U,1,0);
  126.     SetCol(TabStop);
  127.     PutTxt(S);
  128. END; {PrintSoloByte}
  129.  
  130. PROCEDURE PrintBytes(U : UnitPtr; Count, Limit : Word);            {.CP12}
  131. VAR I : Integer;
  132. BEGIN
  133.     I := 0;
  134.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  135.         I := I MOD Limit;
  136.         IF I = 0 THEN PrintAddress(NextLL);
  137.         PrintByteList(U,1,1);
  138.         Inc(I);
  139.         Dec(Count);
  140.     END;
  141. END; {PrintBytes}
  142.  
  143. PROCEDURE BoundaryAlign(UH : UnitPtr);                    {.CP12}
  144. VAR I : Integer;
  145. BEGIN {BoundaryAlign}
  146.     I := ((NextLL + 15) AND $FFF0) - NextLL;
  147.     IF I > 0 THEN
  148.     BEGIN
  149.         PrintBytes(UH,I,8);
  150.         SetCol(36);
  151.         PutTxt('Align to Paragraph Boundary');
  152.         NewTxtLine
  153.     END;
  154. END;  {BoundaryAlign}
  155.  
  156. PROCEDURE PrintOffset(Base: Word);                {.CP05}
  157. BEGIN
  158.     PrintAddress(NextLL);
  159.     PutTxt('[+'+HexW(NextLL-Base)+']: ');
  160. END;
  161.  
  162. PROCEDURE PrintCodeBytes(U : UnitPtr; Count,Limit,Base: Word;X : Boolean); {.CP34}
  163. CONST Xlat : SET OF Char = [' '..Chr($7E)];
  164. VAR I : Integer; j,k : Word; S : String;  C : ^Char;
  165. BEGIN
  166.     I := 0; j := 0; k := Limit*3 + 17; S := '';
  167.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  168.         I := I MOD Limit;
  169.         IF I = 0 THEN
  170.         BEGIN
  171.             IF X THEN
  172.             BEGIN
  173.                 SetCol(K);
  174.                 PutTxt(S);
  175.                 S := '';
  176.             END;
  177.             PrintOffset(Base);
  178.         END;
  179.         IF X THEN
  180.         BEGIN
  181.             C :=Ptr(Seg(U^),Ofs(U^)+NextLL);
  182.             IF C^ IN Xlat THEN S := S + C^
  183.                       ELSE S := S + '.'
  184.         END;
  185.         PrintByteList(U,1,1);
  186.         Inc(I);
  187.         Dec(Count);
  188.     END;
  189.     IF X THEN
  190.     BEGIN
  191.         SetCol(K);
  192.         PutTxt(S);
  193.         S := '';
  194.     END;
  195. END; {PrintCodeBytes}
  196.  
  197. PROCEDURE PrintUnknowns(U : UnitPtr; Till:LL);                {.CP06}
  198. BEGIN {PrintUnknowns}
  199.     PrintTitleBlk('The Purpose of the data below is Unknown',1);
  200.     PrintBytes(U,Till-NextLL,8);
  201.     NewTxtLine;
  202. END;  {PrintUnknowns}
  203.  
  204. PROCEDURE FormatHeader(U : UnitPtr);                    {.CP38}
  205. VAR I : Integer;
  206. BEGIN
  207.     NoteBegin('Formatting Unit Header');
  208.     PrintAddress(NextLL);
  209.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHEYE[I]))+' ');
  210.     SetCol(TabStop);
  211.     PutTxt('=''');
  212.     FOR I := 0 TO 3 DO PutTxt(U^.UHEYE[I]);
  213.     PutTxt('''');
  214.     NewTxtLine;
  215.     Inc(NextLL,4);
  216.     PrintAddress(NextLL);
  217.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHxxx[I]))+' ');
  218.     NewTxtLine;
  219.     Inc(NextLL,4);
  220.     PrintLL(U,'Dict Hdr-This Unit');
  221.     PrintLL(U,'INTERFACE Hash Table');
  222.     PrintLL(U,'PROC Map');
  223.     PrintLL(U,'CSEG Map');
  224.     PrintLL(U,'DSEG Map-Typed CONST''s');
  225.     PrintLL(U,'DSEG Map-Global VARs');
  226.     PrintWd(U,'Usage Unknown');
  227.     PrintLL(U,'Donor Unit List');
  228.     PrintLL(U,'Source File List');
  229.         With U^ Do If UHDBT = UHENC
  230.         Then PrintWd(U,'No Trace Table')
  231.     Else PrintLL(U,'Debug TRACE Table');
  232.     PrintLL(U,'end NON-CODE part of Unit');
  233.     PrintWd(U,'CSEG Size (Aggregate)');
  234.     PrintWd(U,'DSEG Size (Typed CONST''s)');
  235.     PrintWd(U,'Fix-Up List Size (Aggregate)');
  236.     PrintWd(U,'Fix-Up List Size (Typed CONST''s)');
  237.     PrintWd(U,'DSEG Size (Global VARs)');
  238.     PrintLL(U,'DEBUG Hash Table');
  239.         If U^.UHSOV = 0
  240.         Then PrintWd(U,'No Overlay')
  241.         Else PrintWd(U,'Overlay Involved');
  242.     NewTxtLine;
  243.     IF NextLL < U^.UHIHT THEN PrintUnknowns(U,U^.UHIHT);
  244.     NoteEnd;
  245. END; {FormatHeader}
  246.  
  247. FUNCTION NameOfMethod(U:UnitPtr;UsrDE:LL):MethodName;            {.CP20}
  248. VAR DS, DC : DNamePtr; S : DStubPtr; T : TypePtr; N, M : String[64];
  249. BEGIN
  250.     N := ''; M := '???';
  251.     IF UsrDE <> $FFFF THEN
  252.     BEGIN
  253.         DS := DNamePtr(PtrAdjust(U,UsrDE));
  254.         M  := DS^.DSymb;
  255.         S  := AddrStub(DS);
  256.         IF Public(DS^.DForm) = 'S' THEN   {ensure subprogram entry}
  257.         IF (S^.sSTp AND $10) <> 0 THEN {get OBJECT Name Qualifier}
  258.         IF  S^.sSPS <> 0 THEN
  259.         BEGIN
  260.             T  := TypePtr(PtrAdjust(U,S^.sSPS));    {to Object TD}
  261.             DC := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  262.             N  := DC^.Dsymb+'.';
  263.         END
  264.     END;
  265.     NameOfMethod := N + M
  266. END;   {NameOfMethod}
  267.  
  268. PROCEDURE FormatDictionary(U : UnitPtr);            {.CP19}
  269.  
  270.     PROCEDURE PrintDictEntry;
  271.     VAR D,DB : DNamePtr; S : DStubPtr; I : Integer; It : Byte;
  272.               RP : VarStubPtr; DF : Char; DFM : String[8];
  273.         T : String[44]; W : String;
  274.     BEGIN {PrintDictEntry}
  275.         D := AddrDict(U,SurveyWork.LocLL); S := AddrStub(D);
  276.                 RP := @S^.sRVF;
  277.         WITH SurveyWork, D^, S^ DO BEGIN
  278.             I := 4+(Length(DSymb) SHR 4);
  279.                         DF := Public(DForm);
  280.                         IF DF <> DForm Then DFM := 'Private ' Else DFM := '';
  281.             CASE DF OF
  282.                 'O','T','U','V',
  283.                 'W','Q','X':     Inc(I);
  284.                 'P':        Inc(I,2);
  285.                 'Y','R':        Inc(I,4);
  286.                                 'S':            Inc(I,6);
  287.             END; {CASE}
  288.             W := '';                {.CP13}
  289.             IF DF = 'R' THEN
  290.                         Case sRAM Of
  291.               $08: IF SurveyWork.LocOwn <> 0
  292.                    THEN W := NameOfMethod(U,SurveyWork.LocOwn);
  293.                           $10,$01,$00: ;
  294.             ELSE With RP^ DO
  295.                 IF ROB <> 0 THEN W := NameOfMethod(U,ROB);
  296.                         End;
  297.             IF W = '???' THEN W := '' ELSE
  298.             IF W <> '' THEN W := W + '.';
  299.             PrintTitleBlk('Dictionary Entry For: "'+ W +
  300.                 NameOfMethod(U,SurveyWork.LocLL)+'"',I);
  301.             IF HLink <> 0                {.CP29}
  302.             THEN PrintLL(U,AddrDict(U,HLink)^.DSymb)
  303.             ELSE PrintWd(U,'(no backward link)');
  304.             PrintBytes(U,1,1);
  305.             SetCol(TabStop);
  306.             PutTxt(DFM+'Type "'+DF+'" -> ');
  307.             CASE DF OF                                                {.CP18}
  308.                 'O': PutTxt('GOTO Label');  'P': PutTxt('Constant');
  309.                 'Y': PutTxt('Unit');        'T': PutTxt('Built-In Procedure');
  310.                 'W': PutTxt('Port Array');  'U': PutTxt('Built-In Function');
  311.                 'Q': PutTxt('Named Type');  'V': PutTxt('Built-In "NEW"');
  312.                 'X': PutTxt('External VAR');
  313.                 'R': CASE sRAM OF
  314.                        $00: PutTxt('Global VAR');
  315.                        $01: PutTxt('Typed CONST');
  316.                        $02: PutTxt('Local VAR (on Stack)');
  317.                                        $03: PutTxt('Absolute VAR [Seg:Ofs]');
  318.                        $06: PutTxt('Self VAR (ADDR on Stack)');
  319.                        $08: PutTxt('Record/Object Field');
  320.                                        $10: PutTxt('Absolute VAR (Equated)');
  321.                                        $22: PutTxt('VALUE Arg on Stack');
  322.                                        $26: PutTxt('VAR Arg on Stack');
  323.                                        Else PutTxt('New Data Type');
  324.                      END; {CASE sRAM}
  325.                 'S': IF sSVM = 0                     {.CP12}
  326.                                      Then Case (sSTp AND $70) Of
  327.                                           $10: PutTxt('Method');
  328.                                           $30: PutTxt('Constructor');
  329.                                           $50: PutTxt('Destructor');
  330.                                           Else PutTxt('Subprogram')
  331.                                           End
  332.                                      Else PutTxt('Virtual Method');
  333.             END; {CASE DForm OF}
  334.             PrintBytes(U,Length(DSymb)+1,16);
  335.             SetCol(TabStop); PutTxt('="'+DSymb+'"');
  336.             NewTxtLine;
  337.             CASE DF OF { Format the Stub Part }        {.CP13}
  338.                 'O': PrintWd(U,'Unknown purpose)');
  339.                 'P': BEGIN
  340.                     PrintLG(U,'type descriptor');
  341.                     PrintBytes(U,LastLL-NextLL,8); {Temporary Fix}
  342.                     {since value can be a string, we really need to check
  343.                      the type descriptor out but that usually lies in the
  344.                      system unit.  We circumvent for now by relying on the
  345.                      distance to the next structure to determine the size
  346.                      of the constant data for print purposes }
  347.                     SetCol(TabStop); PutTxt('Constant Value');
  348.                     NewTxtLine;
  349.                      END; {CASE 'P'}
  350.                 'Y': BEGIN                {.CP07}
  351.                     PrintWd(U,'TURBO Work?');
  352.                     PrintWd(U,'unknown purpose-signature???');
  353.                     PrintLL(U,'next unit in list');
  354.                     PrintLL(U,'prior unit in list');
  355.                     NewTxtLine;
  356.                      END; {CASE 'Y'}
  357.             'T','U','V': BEGIN                {.CP4}
  358.                     PrintWd(U,'Usage Unknown');
  359.                     NewTxtLine;
  360.                      END;
  361.                 'W': BEGIN                {.CP4}
  362.                     PrintSoloByte(U,'0=byte array, 1=word array');
  363.                     NewTxtLine;
  364.                      END;
  365.                 'Q','X': BEGIN                {.CP4}
  366.                     PrintLG(U,'type descriptor');
  367.                     NewTxtLine;
  368.                      END;
  369.                 'R': BEGIN                      {.CP47}
  370.                                         It := sRAM AND $1F;
  371.                     CASE sRAM OF
  372.                            $00: T := 'Global VAR in DS';
  373.                            $01: T := 'Typed CONST in DS';
  374.                            $02: IF RP^.ROfs > $7FFF
  375.                             THEN T := 'Local VAR on Stack'
  376.                             ELSE T := 'VALUE(Stack)';
  377.                                                $03: T := 'Absolute [Seg:Ofs]';
  378.                            $06: T := 'ADDR(Self) on Stack';
  379.                            $08: T := 'Record/Object Field';
  380.                                                $10: T := 'Absolute Equivalence';
  381.                                                $22: T := 'Arg On Stack (VALUE)';
  382.                                                $26: T := 'Arg On Stack (VAR)';
  383.                         ELSE    T := '**** NEW CODE TO CHECK ****'
  384.                     END; {CASE sRAM}
  385.                     PrintSoloByte(U,T);
  386.                     T := '';
  387.                                         Case It Of
  388.                                            $03: Begin
  389.                                                   PrintWd(U,'Absolute Offset');
  390.                                                   PrintWd(U,'Absolute Segment');
  391.                                                 End;
  392.                                            $10: PrintLG(U,'Absolute Ref Stub');
  393.                                            Else Begin
  394.                             IF (It = $2) OR (It = $6) THEN With RP^ DO
  395.                                IF RP^.ROfs > $7FFF
  396.                                THEN T := 'BP-'+HexW($10000-ROfs)
  397.                                ELSE T := 'BP+'+HexW(ROfs)
  398.                             ELSE T := 'bytes';
  399.                             PrintWd(U,'allocation offset ('+T+')');
  400.                             CASE It OF
  401.                         $0: T := 'Entry offset in VAR DSeg Map';
  402.                         $1: T := 'Entry offset in CON DSeg Map';
  403.                             $2,$6:
  404.                                                     IF RP^.ROB = 0
  405.                             THEN T := 'no containing scope'
  406.                             ELSE T := 'LL(containing Scope)';
  407.                         $8: IF RP^.ROB = 0
  408.                             THEN T := 'no successor field/method'
  409.                             ELSE T := 'LL(successor field/method)';
  410.                             ELSE     T := 'Usage Unknown'
  411.                            END; {CASE sRAM}
  412.                            PrintWd(U,T);
  413.                                            End End;
  414.                     PrintLG(U,'type descriptor');
  415.                      END; {CASE 'R'}
  416.                 'S': BEGIN                {.CP33}
  417.                     T := '';
  418.                     IF  ((sSTp AND $01) = 0) AND
  419.                                             ((sSTp AND $16) = 0) THEN T := '+NEAR' ELSE
  420.                     IF (sSTp AND $10) <> 0 THEN
  421.                     CASE (sSTp AND $60) OF
  422.                         $00: T := '+Method';    $20: T := '+Constructor';
  423.                         $40: T := '+Destructor';
  424.                         ELSE T := '+Method?'
  425.                     END;
  426.                     IF (sSTp AND $08) <> 0 THEN T := T + '+EXTERNAL';
  427.                     IF (sSTp AND $01) <> 0 THEN T := T + '+FAR';
  428.                     IF (sSTp AND $02) <> 0 THEN T := T + '+INLINE';
  429.                                         IF (sSTp AND $04) <> 0 THEN T := T + '+INTERRUPT';
  430.                                         IF (sSTp AND $80) <> 0 THEN T := T + '+ASSEMBLER';
  431.                     IF Length(T) > 0 THEN Delete(T,1,1);
  432.                     PrintSoloByte(U,T);
  433.                                         PrintSoloByte(U,'Usage Unknown');
  434.                     IF (sSTp AND $02) <> 0  THEN T := 'INLINE Code Bytes'
  435.                                 ELSE T := 'offset in PROC Map';
  436.                     PrintWd(U,T);
  437.                     IF sSPS = 0 THEN T := 'no containing scope'
  438.                             ELSE T := 'LL(containing scope)';
  439.                     PrintWd(U,T);
  440.                     IF sSHT = 0 THEN T := 'no local Hash Table'
  441.                             ELSE T := 'LL(local scope Hash Table)';
  442.                     PrintWd(U,T);
  443.                                         IF sSVM = 0
  444.                                         THEN PrintWd(U,'Not Used')
  445.                                         ELSE PrintWd(U,'Method Ptr Offset in VMT');
  446.                                         SetCol(1);
  447.                     END; {CASE 'S'}
  448.             END; {CASE DForm OF}
  449.         END; {WITH}
  450.  
  451.     END;  {PrintDictEntry}
  452.  
  453.     PROCEDURE PrintTypeEntry;                    {.CP46}
  454.     VAR T : TypePtr; W : String[64]; D : DNamePtr; I : Integer;
  455.  
  456.     BEGIN {PrintTypeEntry}
  457.         T := TypePtr(PtrAdjust(U,SurveyWork.LocLL)); I := 0;
  458.         CASE T^.tpTC OF
  459.             $01, $02, $09: I := 2; $04, $05, $07, $08: I := 1;
  460.             $0C..$0F: I := 3; $03: I := 10;  $06: I := 7 + 2*T^.PNPrm;
  461.         END; {CASE}
  462.         W := '';
  463.         IF SurveyWork.LocOwn <> 0
  464.         THEN W := NameOfMethod(U,SurveyWork.LocOwn) ELSE
  465.         IF T^.tpTC = $03 THEN W := NameOfMethod(U,T^.ObjtName);
  466.         IF (W <> '') AND (W <> '???') THEN W := ' For: "' + W + '"';
  467.         PrintTitleBlk('Type Descriptor' + W,I+2);
  468.         WITH T^ DO BEGIN
  469.             PrintBytes(U,2,8);SetCol(TabStop);
  470.             CASE tpTC OF
  471.                 $00: W := 'un-typed';       $01: W := 'Array';
  472.                 $02: W := 'Record';         $03: W := 'Object';
  473.                 $04: W := 'File';           $05: W := 'Text';
  474.                 $06: W := 'Procedure';      $07: W := 'Set';
  475.                 $08: W := 'Pointer';        $09: W := 'String';
  476.                 $0A: CASE tpTQ OF
  477.                     $00: W := 'Single';       $02: W := 'Extended';
  478.                     $04: W := 'Double';       $06: W := 'Comp';
  479.                     ELSE W := '8087-Floating?'
  480.                      END; {CASE tpTQ}
  481.                 $0B: W := 'Real';
  482.                 $0C: CASE tpTQ OF
  483.                     $00: W := 'un-named byte integer';  $01: W := 'ShortInt';
  484.                     $02: W := 'Byte';      $04: W := 'un-named word integer';
  485.                     $05: W := 'Integer';   $06: W := 'Word';
  486.                     $0C: W := 'un-named double-word integer';
  487.                     $0D: W := 'LongInt';
  488.                     ELSE W := 'unknown integer type';
  489.                      END; {CASE tpTQ}
  490.                 $0D: W := 'Boolean';     $0E: W := 'Char';
  491.                 $0F: W := 'enumeration';
  492.                 ELSE W := 'unknown type code';
  493.             END; {CASE tpTC OF}
  494.             PutTxt('Type='+W);
  495.             PrintWd(U,'Storage Width (bytes)');
  496.                         If tpML = 0
  497.                         Then If tpTC = $06
  498.                              Then PrintWd(U,'NO Next Method')
  499.                              Else PrintWd(U,'Usage Unknown')
  500.                         Else PrintLL(U,'Dict Hdr, Next Method');
  501.             CASE tpTC OF                        {.CP05}
  502.                 $01: BEGIN
  503.                     PrintLG(U,'Base Type Desc');
  504.                     PrintLG(U,'Array Bounds');
  505.                      END;
  506.                 $02: BEGIN                    {.CP04}
  507.                     PrintLL(U,'Field List Hash Table');
  508.                     PrintLL(U,'Dict Entry of 1st Field');
  509.                      END;
  510.                 $03: BEGIN                    {.CP17}
  511.                     PrintLL(U,'Field/Method Hash Table');
  512.                     PrintLL(U,'Field/Method Dictionary');
  513.                     WITH ObjtOwnr DO
  514.                         IF NilLG(U,NextLL)
  515.                         THEN PrintLG(U,'nothing inherited')
  516.                         ELSE PrintLG(U,'ancestor Object Desc');
  517.                     PrintWd(U,'Size of VMT (bytes)');
  518.                     IF ObjtDMap = $FFFF
  519.                         THEN PrintWd(U,'there is no VMT')
  520.                         ELSE PrintWd(U,'DSeg Map Offset of VMT Template');
  521.                     IF ObjtVMTO = $FFFF
  522.                         THEN PrintWd(U,'Object has no VIRTUAL Methods')
  523.                         ELSE PrintWd(U,'Offset in Object to VMT Pointer');
  524.                     D := AddrDict(U,ObjtName);
  525.                     PrintLL(U,'Dict Entry ('+D^.DSymb+')');
  526.                                         PrintBytes(U,8,8);
  527.                                         SetCol(TabStop);
  528.                                         PutTxt('Usage Unknown');
  529.                      END;
  530.                 $06: BEGIN                    {.CP21}
  531.                     IF NilLG(U,NextLL)
  532.                     THEN PrintLG(U,'Procedures have no Function Result')
  533.                     ELSE PrintLG(U,'Function Result Type');
  534.                     IF PNPrm = 0 THEN PrintWd(U,'no parameter list') ELSE
  535.                     BEGIN
  536.                         Str(PNPrm,W); W := W + ' Formal Parameter';
  537.                         IF PNPrm > 1 THEN W := W + 's';
  538.                         PrintWd(U,W);
  539.                         FOR I := 1 TO PNPrm DO WITH PFPar[I] DO BEGIN
  540.                             Str(I,W);
  541.                             PrintLG(U,'Parm ' + W + ' TypDesc');
  542.                             IF fPAM = $02
  543.                             THEN W := 'Pass VALUE on Stack'
  544.                             ELSE IF fPAM = $06
  545.                                 THEN W := 'Pass ADDRESS on Stack'
  546.                                 ELSE W := '**** NEW CODE VALUE ***';
  547.                             PrintSoloByte(U,W)
  548.                         END; {FOR}
  549.                     END;
  550.                      END;  { CASE $06 }
  551.                 $04..                        {.CP20}
  552.                 $05: PrintLG(U,'Base File TypeDesc');
  553.                 $07: PrintLG(U,'Base Set TypeDesc');
  554.                 $08: PrintLG(U,'Base Ptr TypeDesc');
  555.                 $09: BEGIN
  556.                     PrintLG(U,'Type[array of char]');
  557.                     PrintLG(U,'Array Bounds TypeDesc');
  558.                      END;
  559.                 $0C..                                                      {.CP12}
  560.                 $0F: BEGIN
  561.                     PrintBytes(U,SizeOf(T^.LoBnd),8);
  562.                     SetCol(TabStop);PutTxt('Subrange Lower Bound');
  563.                     PrintBytes(U,SizeOf(T^.HiBnd),8);
  564.                     SetCol(TabStop);PutTxt('Subrange Upper Bound');
  565.                     PrintLG(U,'Upward Compat TypeDesc');
  566.                      END; { $0C,$0D,$0E,$0F}
  567.             END; {CASE tpTC OF}
  568.         END; {WITH}
  569.  
  570.     END;  {PrintTypeEntry}
  571.  
  572.     PROCEDURE PrintHashEntry;                               {.CP22}
  573.     VAR H : HashPtr;
  574.  
  575.         FUNCTION PrintEmptyHash(Bot,Top:Word):Word;
  576.         VAR  I, J, K : Word;
  577.         BEGIN
  578.             I := Bot;
  579.             WITH H^ DO REPEAT
  580.                     IF Slt[I] = 0
  581.                     THEN Inc(I)
  582.                     ELSE Top := I-1;
  583.                    UNTIL Top < I;
  584.             K := 0;
  585.             WITH H^ DO FOR J := Bot TO Top DO BEGIN
  586.                 IF (K AND $3)=0 THEN PrintAddress(NextLL);
  587.                 PutTxt(HexB(LO(Slt[J]))+' ');
  588.                 PutTxt(HexB(HI(Slt[J]))+' ');
  589.                 Inc(NextLL,2);
  590.                 Inc(K);
  591.             END;
  592.             PrintEmptyHash := I
  593.         END; {PrintEmptyHash}
  594.  
  595.     VAR  D : DNamePtr; I, J, K, N : Word; W : String[44];    {.CP26}
  596.  
  597.     BEGIN {PrintHashEntry}
  598.         H := AddrHash(U,SurveyWork.LocLL);
  599.         N := H^.Bas DIV 2;
  600.         W := '';
  601.         IF SurveyWork.LocLL = U^.UHIHT
  602.         THEN W := '- INTERFACE Dictionary'    ELSE
  603.         IF SurveyWork.LocLL = U^.UHDHT
  604.         THEN W := '- Turbo DEBUG Dictionary'    ELSE
  605.         IF SurveyWork.LocOwn <> 0
  606.         THEN W := 'Owned By: "'+NameOfMethod(U,SurveyWork.LocOwn)+'"';
  607.         PrintTitleBlk('Hash Table '+W,3);
  608.         PrintWd(U,'Bytes in Hash Table - 2');
  609.         SetCol(1);PutTxt('----');
  610.         I := 0;
  611.  
  612.         WITH H^ DO REPEAT
  613.             IF Slt[I] <> 0 THEN
  614.             BEGIN
  615.                 PrintLL(U,AddrDict(U,Slt[I])^.DSymb);
  616.                 Inc(I)
  617.             END ELSE I := PrintEmptyHash(I,N);
  618.         UNTIL I > N;
  619.         NewTxtLine;
  620.     END;  {PrintHashEntry}
  621.  
  622.     PROCEDURE PrintInLineEntry;                             {.CP15}
  623.     VAR D : DNamePtr; S : DStubPtr; I : Integer;  T : TypePtr;
  624.  
  625.     BEGIN {PrintInLineEntry}
  626.         D := AddrDict(U,SurveyWork.LocOwn);   { Procedure  Header }
  627.         S := AddrStub(D);                     { Procedure  Stub   }
  628.         T := AddrProcType(S);                 { Type Descriptor   }
  629.         WITH SurveyWork, T^ DO BEGIN
  630.             I := (S^.sSPM+15) SHR 4;
  631.             PrintTitleBlk('INLINE Code Bytes FOR: "'+
  632.                     NameOfMethod(U,SurveyWork.LocOwn)+'"',I);
  633.             PrintBytes(U,S^.sSPM,16);
  634.             SetCol(1);
  635.         END;
  636.     END;  {PrintInLineEntry}
  637.  
  638. VAR I : Word; BU : SurveyRec; DoneDict,DoneHash : Boolean; BUL : LL;  {.CP30}
  639. BEGIN {FormatDictionary}
  640.     NoteBegin('Formatting Dictionary');
  641.     DoneHash := False; DoneDict := False;
  642.         FetchNextSurvey(U,SurveyWork);
  643.     WITH SurveyWork DO
  644.     While LocTyp <> cvNULL DO BEGIN
  645.                 LastLL := LocNxt;
  646.         BU := SurveyWork;
  647.         IF NextLL < LocLL THEN
  648.         IF NOT DoneHash THEN PrintUnknowns(U,LocLL) ELSE
  649.                 IF DoneDict     THEN PrintUnknowns(U,LocLL) ELSE
  650.         BEGIN
  651.             BUL := LastLL;
  652.             LocLL := NextLL; LastLL := BU.LocLL;
  653.             LocOwn := 0; LocTyp := cvType;
  654.             PrintTypeEntry;
  655.             SurveyWork := BU; LastLL := BUL;
  656.         END;
  657.         CASE LocTyp OF
  658.              cvName: BEGIN PrintDictEntry; DoneDict := True END;
  659.              cvType: PrintTypeEntry;
  660.              cvHash: BEGIN PrintHashEntry; DoneHash := True END;
  661.              cvINLN: PrintInLineEntry;
  662.         END; {CASE}
  663.                 FetchNextSurvey(U,SurveyWork);
  664.     END;   {While}
  665.     IF NextLL < U^.UHPMT THEN PrintUnknowns(U,U^.UHPMT);
  666.     NoteEnd;
  667. END;  {FormatDictionary}
  668.  
  669. FUNCTION NameOfObject(U:UnitPtr;UsrDE:LL):LexNam;        {.CP15}
  670. VAR D : DNamePtr; T : TypePtr;
  671. BEGIN
  672.     IF UsrDE = $0000 THEN NameOfObject := '???' ELSE
  673.     BEGIN
  674.         T  := TypePtr(PtrAdjust(U,UsrDE));    {to Object TD}
  675.         D  := Nil;
  676.         IF T^.tpTC = $03 THEN
  677.         BEGIN
  678.             D  := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  679.             NameOfObject := D^.Dsymb
  680.         END ELSE
  681.             NameOfObject := '???'
  682.     END
  683. END;  {NameOfObject}
  684.  
  685. PROCEDURE CSegHeadings; Far;                    {.CP45}
  686. BEGIN
  687.    SetCol(8);
  688.    PutTxt('Entry   Turbo Segmt FixUp Trace : Source File   Load [Fix-Ups]');
  689.    SetCol(8);
  690.    PutTxt('Offset  Work? Bytes Bytes Entry : For CODE Seg  ADDR 1''st last');
  691.    SetCol(8);
  692.    PutTxt('------  ----- ----- ----- ----- : ------------  ---- ---- ----');
  693. END; {CSegHeadings}
  694.  
  695. PROCEDURE FormatCSegMap(UPt:UnitPtr);                {.CP35}
  696.  
  697. VAR    C : CMapTabPtr; SF : SrcFilePtr;
  698.     OldTabSet, Base, Cx, NMapC : Word;
  699. BEGIN
  700.     NoteBegin('Formatting CSeg Map');
  701.     OldTabSet := TabStop;
  702.     TabStop := 42;
  703.         NMapC := Upt^.UHTMT-Upt^.UHCMT; Cx := 0;
  704.  
  705.     IF NMapC > 0 THEN    { make sure CSeg Map non-empty }
  706.     BEGIN
  707.         PrintTitleBlk('CSeg Map Table',7);
  708.         NextLL := Upt^.UHCMT;
  709.         CSegHeadings;  Base := NextLL;
  710.         REPEAT
  711.             PageOverFlow(6,CSegHeadings);
  712.                         FetchCSegRef(Map,UPt,Cx);
  713.             SF := AddrSrcTabOff(UPt,Map.MapSrc);
  714.             PrintCodeBytes(UPt,8,8,Base,False);
  715.             SetCol(TabStop);
  716.             PutTxt(SF^.SrcName);
  717.             SetCol(TabStop+14);
  718.             PutTxt(HexW(Map.MapLod)+' ');
  719.             IF Map.MapFxJ <> 0 THEN
  720.             BEGIN
  721.                 PutTxt(HexW(Map.MapFxI)+' ');
  722.                 PutTxt(HexW(Map.MapFxJ));
  723.             END;
  724.             Inc(Cx,SizeOf(CMapRec));
  725.         UNTIL Cx > NMapC-1;
  726.     END;
  727.     TabStop := OldTabSet;
  728.     NoteEnd;
  729. END;  { FormatCSegMap }
  730.  
  731. PROCEDURE ProcHeadings; Far;                                    {.CP38}
  732. BEGIN
  733.     SetCol(8); PutTxt('Entry   Turbo Turbo CSeg  PROC  : Jump Byte   Name Of');
  734.     SetCol(8); PutTxt('Offset  Work? Work? Map^  Ofset : Addr Cnt   Procedure');
  735.     SetCol(8); PutTxt('------  ----- ----- ----- ----- : ---- ----  ----------');
  736. END; {ProcHeadings}
  737.  
  738. PROCEDURE FormatProcMap(UPt:UnitPtr);                            {.CP31}
  739. VAR     Base, I, J, OldTabStop : Word;
  740. BEGIN {FormatProcMap}
  741.     NoteBegin('Formatting PROC Map');
  742.     OldTabStop := TabStop;
  743.     TabStop := 42;
  744.     SetCol(1);
  745.     IF CountPMapSlots(UPt) > 0 THEN  { Make Sure PROC Map not empty }
  746.     BEGIN
  747.         PrintTitleBlk('PROC Map Table',7);
  748.         NextLL := Upt^.UHPMT;
  749.         I := 0; Base := NextLL;
  750.         ProcHeadings;
  751.         REPEAT
  752.             PageOverFlow(3,PROCHeadings);
  753.                         FetchProcRef(Map,Upt,I);
  754.             PrintCodeBytes(UPt,8,8,Base,False);
  755.             SetCol(TabStop);
  756.             PutTxt(HexW(Map.MapEPT)+' ');
  757.             PutTxt(HexW(Map.MapSiz)+'  ');
  758.             IF I = 0 THEN
  759.                 IF Map.MapCSM = $FFFF
  760.                 THEN PutTxt('Not Used (No Unit Init Code)')
  761.                 ELSE PutTxt('Unit Initialization Code')
  762.             ELSE PutTxt(NameOfMethod(UPt,Map.MapOwn));
  763.             Inc(I,SizeOf(PMapRec));
  764.         UNTIL NextLL >= Upt^.UHCMT;
  765.     END;
  766.     TabStop := OldTabStop;
  767.     NoteEnd;
  768. END; {FormatProcMap}
  769.  
  770. PROCEDURE CONSTHeadings; Far;                                   {.CP51}
  771. BEGIN
  772.   SetCol(8); PutTxt('Entry   Turbo Segmt FixUp  VMT  : Load [Fix-Ups]');
  773.   SetCol(8); PutTxt('Offset  Work? Bytes Bytes Owner : ADDR 1''st last');
  774.   SetCol(8); PutTxt('------  ----- ----- ----- ----- : ---- ---- ----');
  775. END; {CONSTHeadings}
  776.  
  777. PROCEDURE FormatTypedConMap(UPt:UnitPtr);            {.CP44}
  778. VAR I, J, K : Integer; Sofs, Base : Word;
  779. BEGIN { FormatTypedConMap }
  780.     NoteBegin('Formatting CONST DSeg Map');
  781.     J := CountDMapSlots(UPt);
  782.     IF J > 0 THEN
  783.     BEGIN
  784.         PrintTitleBlk('CONST DSeg Map Table',7);
  785.         K := TabStop;
  786.         TabStop := 58;
  787.         NextLL := Upt^.UHTMT;
  788.         Base := NextLL; Sofs := 0;
  789.         CONSTHeadings;
  790.         FOR I := 0 TO J-1 DO
  791.         BEGIN
  792.             PageOverFlow(7,ConstHeadings);
  793.                         FetchCONsRef(Map,Upt,Sofs);
  794.             PrintCodeBytes(UPt,8,8,Base,False);
  795.                         PutTxt('  '+HexW(Map.MapLod)+' ');
  796.                         If Map.MapFxJ > 0 Then
  797.                         Begin
  798.                              PutTxt(HexW(Map.MapFxI)+' ');
  799.                              PutTxt(HexW(Map.MapFxJ));
  800.                         End;
  801.             SetCol(TabStop);
  802.             IF (Map.MapTyp = mfTVMT)
  803.             THEN PutTxt('VMT For: '+NameOfObject(UPt,Map.MapOwn)) ELSE
  804.                         Begin
  805.                            PutTxt('From: ');
  806.                            Case Map.MapTyp Of
  807.                              mfXTRN: PutTxt('Linked File');
  808.                              mfINTF: PutTxt('_INTERFACE');
  809.                              mfIMPL: PutTxt('_IMPLEMENTATION');
  810.                              mfNEST: PutTxt('PROC('
  811.                                      +NameOfMethod(Upt,Map.MapOwn)+')');
  812.                              Else    PutTxt('???');
  813.                            End;
  814.                         End;
  815.                         Inc(Sofs,SizeOf(DMapRec));
  816.         END; { FOR }
  817.         TabStop := K;
  818.     END; { IF }
  819.     NoteEnd;
  820. END;  { FormatTypedConMap }
  821.  
  822. PROCEDURE VARHeadings; Far;                                     {.CP42}
  823. BEGIN
  824.     SetCol(8); PutTxt('Entry   Turbo Segmt Usage Usage');
  825.     SetCol(8); PutTxt('Offset  Work? Bytes  ???   ??? ');
  826.     SetCol(8); PutTxt('------  ----- ----- ----- -----');
  827. END; {VARHeadings}
  828.  
  829. PROCEDURE FormatGlobalVarMap(U : UnitPtr);
  830.  
  831. VAR Base, Sofs, I : Word; SaveTab : Integer;
  832. BEGIN
  833.     NoteBegin('Formatting Global VAR Map');
  834.     SaveTab := TabStop;
  835.     TabStop := 42;
  836.     IF U^.UHDMT <> U^.UHLDU THEN
  837.     BEGIN
  838.         I := 0;
  839.         PrintTitleBlk('Global VAR DSeg Map Table',5);
  840.         VARHeadings;
  841.         NextLL := U^.UHDMT;
  842.         Base := NextLL;
  843.                 Sofs := 0;
  844.         WHILE U^.UHLDU > NextLL DO
  845.         BEGIN
  846.             PageOverFlow(5,VARHeadings);
  847.             PrintCodeBytes(U,8,8,Base,False);
  848.             SetCol(TabStop);
  849.                         FetchVARsRef(Map,U,Sofs);
  850.                         PutTxt('From: ');
  851.                         Case Map.MapTyp Of
  852.                           mfXTRN: PutTxt('Linked File');
  853.                           mfINTF: PutTxt('_INTERFACE');
  854.                           mfIMPL: PutTxt('_IMPLEMENTATION');
  855.                           Else    PutTxt('???');
  856.                         End;
  857.                         Inc(Sofs,SizeOf(DMapRec));
  858.             Inc(I);
  859.         END;
  860.     END;
  861.     TabStop := SaveTab;
  862.     NoteEnd;
  863. END; {FormatGlobalVarMap}
  864.  
  865. PROCEDURE FormatUnitDonorList(U : UnitPtr);            {.CP22}
  866. VAR UCP : UDonorPtr; UNE : LL;
  867. BEGIN
  868.     NoteBegin('Formatting Donor Unit List');
  869.     SetCol(1);
  870.     IF U^.UHLSF <> NextLL THEN
  871.     BEGIN
  872.         PrintTitleBlk('Code/Data Donor Unit List',2);
  873.         UCP := UDonorPtr(PtrAdjust(U,U^.UHLDU));
  874.         WHILE NextLL <> U^.UHLSF DO WITH UCP^ DO BEGIN
  875.             IF LinesRemaining < 2 THEN NewTxtPage;
  876.             UNE := FormLL(U,UCP)+SizeOf(UCP^.UDExxx) + 1 + Ord(UDEnam[0]);
  877.             PrintWd(U,'Offset='+HexW(NextLL-U^.UHLDU)+', TURBO Work?');
  878.             PrintBytes(U,1+Ord(UDEnam[0]),9);
  879.             SetCol(TabStop);
  880.             PutTxt('=''' + UDEnam + '''');
  881.             SetCol(1);
  882.             UCP := UDonorPtr(PtrAdjust(U,UNE));
  883.         END;
  884.     END;
  885.     NoteEnd;
  886. END; {FormatUnitDonorList}
  887.  
  888. PROCEDURE FormatSourceFileList(U : UnitPtr);                    {.CP52}
  889. VAR S : SrcFilePtr; SLL : LL; StA : String[10]; StW : String[4];
  890.     OldTabStop : Integer;
  891.  
  892.     PROCEDURE FormatTime(Time : Word);
  893.     VAR I : Integer;
  894.     BEGIN
  895.         Str( Time SHR 11:2,StA);         StA := StA + ':';
  896.         Str((Time AND 2047) SHR 5:2,StW);StA := StA + StW + ':';
  897.         Str((Time AND 31) SHL 1:2,StW);  StA := StA + StW;
  898.         FOR I := 1 TO 7 DO IF StA[I] = ' ' THEN StA[I] := '0';
  899.     END; {FormatTime}
  900.  
  901.     PROCEDURE FormatDate(Date : Word);
  902.     VAR I : Integer;
  903.     BEGIN
  904.         Str((Date AND 511)SHR 5:2,StA); StA := StA + '/';
  905.         Str( Date AND 31:2,StW);        StA := StA + StW + '/';
  906.         Str((Date SHR 9) + 1980:4,StW); StA := StA + StW;
  907.         FOR I := 1 TO 4 DO IF StA[I] = ' ' THEN StA[I] := '0';
  908.     END; {FormatDate}
  909.  
  910. BEGIN {FormatSourceFileList}
  911.     NoteBegin('Formatting Source File List');
  912.     OldTabStop := TabStop;
  913.     TabStop := 48;
  914.     PrintTitleBlk('Source File List',5);
  915.     SLL := U^.UHDBT;
  916.     S := SrcFilePtr(PtrAdjust(U,NextLL));
  917.     WHILE SLL <> NextLL DO WITH S^ DO BEGIN
  918.         IF LinesRemaining < 5 THEN NewTxtPage;
  919.         PrintSoloByte(U,'Flag');
  920.         PrintWd(U,'TURBO Work?');
  921.         CASE SrcFlag OF
  922.             $03,$04:         { .PAS OR .INC file }
  923.                 BEGIN
  924.                     FormatTime(SrcTime); PrintWd(U,'Time-Stamp='+StA);
  925.                     FormatDate(SrcDate); PrintWd(U,'Date-Stamp='+StA);
  926.                 END
  927.             ELSE    BEGIN
  928.                     PrintBytes(U,4,9);SetCol(TabStop);
  929.                     PutTxt('NO Time, Date-Stamps');
  930.                 END
  931.         END;   { CASE }
  932.         PrintBytes(U,1+Ord(SrcName[0]),13);
  933.         SetCol(TabStop);PutTxt('='''+SrcName+'''');
  934.         SetCol(1);
  935.         S := AddrNxtSrc(U,S);
  936.     END;
  937.     TabStop := OldTabStop;
  938.     NoteEnd;
  939. END; {FormatSourceFileList}
  940.  
  941. PROCEDURE FormatTraceTable(U : UnitPtr);                        {.CP38}
  942. VAR    T : TraceRecPtr; S,X : String[6]; I,J, Limit : Word;
  943. BEGIN
  944.     NoteBegin('Formatting Trace Table');
  945.     SetCol(1);
  946.     T := AddrTraceTab(U);
  947.     IF T <> Nil THEN
  948.     BEGIN
  949.         Limit := GetTrExecSize(T);
  950.         PrintTitleBlk('Trace Table for Turbo Debugger is Next (LL at 001A)',
  951.                 7+(Limit SHR 3));
  952.         WHILE T <> Nil DO WITH T^ DO BEGIN
  953.             Limit := GetTrExecSize(T);
  954.             IF LinesRemaining < (7+Limit SHR 3) THEN NewTxtPage;
  955.             IF TrName <> 0
  956.             THEN PrintLL(U,NameOfMethod(U,TrName))
  957.             ELSE PrintWd(U,'Unit Init Code Block');
  958.             PrintWd(U,'Src File: "' + AddrSrcTabOff(U,TrFill)^.SrcName + '"');
  959.             Str(T^.TrPfx,S);  PrintWd(U,S+' Data bytes precede Code');
  960.             Str(T^.TrBeg,S);  PrintWd(U,'BEGIN Stmt at Line # '+S);
  961.             Str(T^.TrLNos,S); PrintWd(U,S+' Lines of Code to Execute');
  962.             I := 1;
  963.             WHILE I <= Limit DO BEGIN
  964.                 J := I + 7;
  965.                 IF J > Limit THEN J := Limit;
  966.                 Str(I-1+TrBeg,S); Str(J-1+TrBeg,X);
  967.                 PrintBytes(U,J+1-I,8);
  968.                 SetCol(TabStop);
  969.                 PutTxt('Code Bytes in Lines '+S+' Thru '+X);
  970.                 NewTxtLine;
  971.                 I := J + 1;
  972.             END;
  973.             T := AddrNxtTrace(U,T);
  974.             NewTxtLine;
  975.         END;
  976.     END;
  977.     NoteEnd;
  978. END; {FormatTraceTable}
  979.  
  980. PROCEDURE FormatEndNonCode(U : UnitPtr);                        {.CP05}
  981. BEGIN
  982.     PrintTitleBlk('End Non-Code Part Of Unit (LL at 001C)',0);
  983.     BoundaryAlign(U);
  984. END; {FormatEndNonCode}
  985.  
  986. PROCEDURE FormatObjectCode(UH : UnitPtr);            {.CP06}
  987. VAR HexOff : Word;
  988.  
  989. VAR    PM : MapRefRec;  MyFil, MyOrg, MyEnd, MyTrc : LL;
  990.     SP : SrcFilePtr; R : FixUpPtr;
  991.     CMaps, CXs, I, J : Integer;      SaveTab : Word; SF : Byte;
  992.  
  993.     PROCEDURE DisplayCode(U : UnitPtr; Count: Word;TrcNdx:LL);
  994.  
  995.         PROCEDURE DisplayCodeLine(VAR P : ObjArg);    {.CP20}
  996.         BEGIN
  997.             WITH P DO WHILE Lim > 0 DO BEGIN
  998.                 UnAssemble(U,P);
  999.                 NextLL := Locn;
  1000.                 PrintOffset(HexOff);
  1001.                 SetCol(16);    PutTxt(Code);
  1002.                 SetCol(39);    PutTxt(Mnem);
  1003.                 SetCol(55);    PutTxt(Opr1);
  1004.                 IF Length(Opr2) > 0 THEN PutTxt(','+Opr2);
  1005.                 IF Length(Opr3) > 0 THEN
  1006.                 BEGIN
  1007.                     IF Opr3[1] <> ';'
  1008.                         THEN PutTxt(',')
  1009.                         ELSE PutTxt(' ');
  1010.                     PutTxt(Opr3)
  1011.                 END;
  1012.                 NewTxtLine;
  1013.             END;
  1014.         END;    {DisplayCodeLine}
  1015.  
  1016.     VAR    P : ObjArg;   I,J,K,L:Word; Limit, IP : LL;     {.CP42}
  1017.         T : TraceRecPtr; S : String[6];
  1018.     BEGIN   {DisplayCode}
  1019.         IF Count > 0 THEN
  1020.         BEGIN
  1021.             Limit := Count;
  1022.             IP  := NextLL;
  1023.             P.TCpu := C286;
  1024.             T := AddrTraceTab(U);
  1025.             IF (T = Nil) OR (TrcNdx = $FFFF) THEN
  1026.             BEGIN
  1027.                 P.Lim := Limit;
  1028.                 P.Obj := IP;
  1029.                 DisplayCodeLine(P);
  1030.                 IP  := P.Obj;
  1031.             END ELSE
  1032.             BEGIN
  1033.                 T := Ptr(Seg(T^),Ofs(T^)+TrcNdx);
  1034.                 L := T^.TrBeg;
  1035.                 K := GetTrExecSize(T);
  1036.                 P.Obj := IP;
  1037.                 I := 1;
  1038.                 WHILE I <= K DO BEGIN
  1039.                     IF T^.TrExec[I] = $80 THEN Inc(I);
  1040.                     P.Lim := T^.TrExec[I];
  1041.                     IF P.Lim > 0 THEN
  1042.                     BEGIN
  1043.                         PutTxt('; ------------> Code From Line: ');
  1044.                         Str(L,S);
  1045.                         PutTxt(S);
  1046.                         IF I = 1 THEN PutTxt('  ("BEGIN" Statement)') ELSE
  1047.                         IF I = K THEN PutTxt('  ("END" Statement)');
  1048.                         NewTxtLine;
  1049.                         DisplayCodeLine(P);
  1050.                     END;
  1051.                     Inc(L); Inc(I);
  1052.                 END;
  1053.                 IP := P.Obj;
  1054.             END;
  1055.             NextLL := IP;
  1056.         END;
  1057.     END; {DisplayCode}
  1058.  
  1059.     PROCEDURE UnAssembleCode(Hash : LL;SF : Byte;        {.CP31}
  1060.                  Org, Limit : Word;
  1061.                  TrcNdx : LL;Comment:Boolean);
  1062.     VAR Stopper : LL;
  1063.     BEGIN
  1064.         IF LinesRemaining < 4 THEN NewTxtPage;
  1065.         Stopper := Limit-Org;
  1066.         IF NextLL > Org THEN Stopper := Limit-NextLL;
  1067.         IF (Stopper > 0) THEN
  1068.         BEGIN
  1069.             IF Comment THEN {Allow Remarks}
  1070.             BEGIN
  1071.                 SetCol(7); PutTxt('Code For ');
  1072.                 IF SF < $05
  1073.                 THEN
  1074.                     IF (Hash <> $FFFF) AND (Hash <> 0)
  1075.                     THEN PutTxt('PROC "'+NameOfMethod(UH,Hash)+'"')
  1076.                     ELSE PutTxt('Unit Initialization')
  1077.                 ELSE
  1078.                 IF (Hash <> $FFFF) AND (Hash <> 0)
  1079.                     THEN PutTxt('PUBLIC "'+NameOfMethod(UH,Hash)+'"')
  1080.                     ELSE PutTxt('PRIVATE or Un-named PUBLIC');
  1081.                 PutTxt(' starts at '+HexW(NextLL));
  1082.                 NewTxtLine;NewTxtLine;
  1083.             END;
  1084.             IF DisAssembly
  1085.                 THEN DisplayCode(UH,Stopper,TrcNdx)
  1086.                 ELSE PrintCodeBytes(UH,Stopper,16,HexOff,True);
  1087.             NewTxtLine;NewTxtLine;
  1088.         END;
  1089.     END;  {UnAssembleCode}
  1090.  
  1091.     PROCEDURE UnAssembleData(S : MapRefRec; SF: Byte);    {.CP13}
  1092.     BEGIN
  1093.         SetCol(7);
  1094.         IF SF <> $05
  1095.             THEN PutTxt('(Preamble Data Begins at ')
  1096.             ELSE PutTxt('(PRIVATE Code or Data Begins at ');
  1097.         PutTxt(HexW(NextLL)+')');
  1098.         NewTxtLine;NewTxtLine;
  1099.         IF SF <> $05
  1100.             THEN PrintCodeBytes(UH,S.MapEPT-NextLL,16,HexOff,True)
  1101.             ELSE UnAssembleCode(S.MapOwn,SF,NextLL,S.MapEPT,$FFFF,False);
  1102.         NewTxtLine;NewTxtLine;
  1103.     END;  {UnAssembleData}
  1104.  
  1105. BEGIN  {FormatObjectCode}                                       {.CP46}
  1106.     NoteBegin('Formatting CODE Segments');
  1107.     IF UH^.UHCMT < UH^.UHTMT THEN
  1108.     BEGIN
  1109.         SaveTab := TabStop;
  1110.         TabStop := 55;
  1111.         R := AddrFixUps(UH);
  1112.         PrintTitleBlk('Object Code Begins Here',0);
  1113.         CMaps := CountCMapSlots(UH)  *SizeOf(CMapRec);   { Code Segments }
  1114.         CXs := (CountPMapSlots(UH)-1)*SizeOf(PMapRec);
  1115.                 SortProcRefs(UH,CSegOrder);
  1116.                 FetchProcRef(Map,UH,CXs);
  1117.         IF (Map.MapEPT = $FFFF)        { remove unused init proc  }
  1118.         THEN Dec(CXs,SizeOf(PMapRec));
  1119.         I := 0;                        { Track PMRefs Table           }
  1120.         J := 0;                        { Track CSeg Map Table     }
  1121.  
  1122.         REPEAT                                                         {.CP30}
  1123.             NewTxtLine;
  1124.                         FetchCSegRef(Map,UH,J);
  1125.                         FetchProcRef(PM,UH,I);
  1126.             WHILE PM.MapCSM < J DO Begin
  1127.                           Inc(I,SizeOf(PMapRec));
  1128.                           FetchProcRef(PM,UH,I);
  1129.                         End;
  1130.             MyOrg := Map.MapLod;            { Segment Load Point }
  1131.             MyEnd := MyOrg + PM.MapSiz;        { Next Segment Start }
  1132.             MyFil := Map.MapSrc;            { Segment Source Fil }
  1133.             MyTrc := AddrCMapTab(UH)^[PM.MapCSM DIV SizeOf(CMapRec)].CsegTrc;
  1134.             SP := AddrSrcTabOff(UH,MyFil);
  1135.             PutTxt('----  Code Segment at '+HexW(NextLL)+' Found In "');
  1136.             PutTxt(SP^.SrcName+'"');
  1137.             NewTxtLine; NewTxtLine;
  1138.             HexOff := NextLL;
  1139.             SF := SP^.SrcFlag;
  1140.             IF (PM.MapEPT <> NextLL)
  1141.                 THEN UnAssembleData(PM,SF);
  1142.             WHILE (I <= CXs) AND (PM.MapCSM = J) DO BEGIN
  1143.                            WITH PM DO
  1144.                  UnAssembleCode(MapOwn,SF,MapEPT,MapEPT+MapSiz,MyTrc,True);
  1145.                  Inc(I,SizeOf(PMapRec));
  1146.                              FetchProcRef(PM,UH,I);
  1147.             END;
  1148.             Inc(J,SizeOf(CMapRec));
  1149.         UNTIL (J >= CMaps);
  1150.  
  1151.         TabStop := SaveTab;
  1152.         SetCol(1);PutTxt('----  END OF ALL OBJECT CODE');
  1153.         NewTxtLine;NewTxtLine;
  1154.         BoundaryAlign(UH);
  1155.     END;
  1156.     NoteEnd;
  1157. END; {FormatObjectCode}
  1158.  
  1159. PROCEDURE FormatDataAreas(UH : UnitPtr);            {.CP44}
  1160. VAR    PD : DMapTabPtr; SaveTab : Word; T : TypePtr;
  1161.     I, MapEnd,Base : Word; EndLL : LL; S : MapRefRec;
  1162. BEGIN
  1163.    NoteBegin('Formatting CONST Data Segments');
  1164.    SaveTab := TabStop;
  1165.    EndLL := NextLL + UH^.UHZDT;
  1166.    IF EndLL <> NextLL THEN
  1167.    BEGIN
  1168.       PrintTitleBlk('CONST Data Segments Follow',5);
  1169.       WITH UH^ DO MapEnd := (UHDMT-UHTMT) DIV SizeOf(DMapRec);
  1170.       PD := AddrDMapTab(UH);
  1171.       FOR I := 0 TO MapEnd-1 DO WITH PD^[I] DO BEGIN
  1172.      NewTxtLine;
  1173.      SetCol(7);
  1174.      IF DSegOwn <> 0 THEN
  1175.      BEGIN
  1176.         T := TypePtr(PtrAdjust(UH,DSegOwn));
  1177.         PutTxt('VMT Template for "');
  1178.         PutTxt(AddrDict(UH,T^.ObjtName)^.DSymb+'"');
  1179.      END ELSE
  1180.          Begin
  1181.             FetchCONsRef(S,UH,SizeOf(DMapRec)*I);
  1182.             PutTxt('Typed CONST''s From: ');
  1183.             Case S.MapTyp Of
  1184.                mfXTRN: PutTxt('Linked File');
  1185.                mfINTF: PutTxt('_INTERFACE');
  1186.                mfIMPL: PutTxt('_IMPLEMENTATION');
  1187.                mfNEST: PutTxt('PROC('+NameOfMethod(UH,S.MapOwn)+')');
  1188.                Else    PutTxt('???');
  1189.             End;
  1190.          End;
  1191.      Base := NextLL;
  1192.      SetCol(1);
  1193.      PrintCodeBytes(UH,DSegCnt,16,Base,True);
  1194.      SetCol(1);
  1195.       END; {FOR}
  1196.       NewTxtLine;PutTxt('----  END OF ALL DATA SEGMENTS');
  1197.       NewTxtLine;NewTxtLine;
  1198.    END; {IF}
  1199.    TabStop := SaveTab;
  1200.    BoundaryAlign(UH);
  1201.    NoteEnd;
  1202. END; {FormatDataAreas}
  1203.  
  1204. PROCEDURE FixUpHeadings; Far;                    {.CP06}
  1205. BEGIN
  1206.    SetCol(7); PutTxt('Un Fl  Map  E-Adr Patch : Ptch Type Refers');
  1207.    SetCol(7); PutTxt('it ag Ofset Ofset Ofset : Size  Map To Unit');
  1208.    SetCol(7); PutTxt('-- -- ----- ----- ----- : ---- ---- --------');
  1209. END; {FixUpHeadings}
  1210.  
  1211. PROCEDURE FormatFixUpList(UH : UnitPtr);            {.CP02}
  1212. TYPE Remark = String[8]; T4 = String[4]; T8 = String[8];
  1213.  
  1214.     PROCEDURE FixUpIdentify(    R : FixUpRec;           {.CP17}
  1215.                 VAR S2, S1 : T4; VAR S3 : T8);
  1216.     VAR PU : UDonorPtr;
  1217.     BEGIN  {FixUpIdentify}
  1218.         CASE (R.FixFlg SHR 6) AND $3 OF
  1219.             0: S1 := 'PROC';    1: S1 := 'CSeg';
  1220.             2: S1 := 'DATA';    3: S1 := 'CONS';
  1221.         END;
  1222.         CASE (R.FixFlg SHR 4) AND $3 OF
  1223.             0: S2 := 'WORD';    1: S2 := 'WD+E';
  1224.             2: S2 := 'SEG ';    3: S2 := 'FPTR';
  1225.         END;
  1226.         IF (R.FixFlg AND $F) <> 0 THEN
  1227.         BEGIN S1 := '??? ';    S2 := '????';  END;
  1228.         PU := UDonorPtr(PtrAdjust(UH,UH^.UHLDU+R.FixDnr));
  1229.         S3 := PU^.UDENam;
  1230.     END;   {FixUpIdentify}
  1231.  
  1232. VAR  R : FixUpPtr; T : TypePtr; PU : UDonorPtr; S:MapRefRec;    {.CP46}
  1233.      RR : FixUpRecPtr; EndS, EndLL : LL;
  1234.      S1,S2:T4;S3 : T8; I, J, K, MapEnd : Word; SaveTab : Word; OV:HeadProc;
  1235. BEGIN
  1236.     NoteBegin('Formatting Fix-Up List');
  1237.     SaveTab := TabStop;
  1238.     TabStop := 33;
  1239.     EndLL := NextLL + UH^.UHZFA;
  1240.     IF EndLL <> NextLL THEN WITH UH^ DO
  1241.     BEGIN
  1242.         PrintTitleBlk('Fix-Up List Follows',7);
  1243.         SetCol(1);
  1244.         J := 0;
  1245.         R := FixUpPtr(PtrAdjust(UH,NextLL));
  1246.         IF UHCMT < UHTMT THEN
  1247.         BEGIN
  1248.             MapEnd := UHTMT-UHCMT; I := 0;
  1249.             While I < MapEnd DO Begin
  1250.                            FetchCSegRef(Map,UH,I);
  1251.                IF Map.MapFxJ <> 0 THEN
  1252.                BEGIN
  1253.                 SetCol(1);
  1254.                 IF LinesRemaining < 9   THEN NewTxtPage
  1255.                             ELSE NewTxtLine;
  1256.                 SetCol(7);
  1257.                 PutTxt('Segment Load Addr = ');
  1258.                 EndS := Map.MapLod;
  1259.                 PutTxt(HexW(EndS));
  1260.                                 SetCol(7);
  1261.                 EndS := EndS + Map.MapSiz;
  1262.                 PutTxt('Fix-Up''s For CSeg Map Entry at ');
  1263.                 PutTxt(HexW(I + UHCMT));
  1264.                 SetCol(1);NewTxtLine;
  1265.                 FixUpHeadings;
  1266.                                 K := Map.MapFxI;
  1267.                 While K <= Map.MapFxJ DO BEGIN
  1268.                                         RR := PtrAdjust(UH,K);
  1269.                     PageOverFlow(2,FixUpHeadings);
  1270.                     FixUpIdentify(RR^,S1,S2,S3);
  1271.                     PrintBytes(UH,8,8);
  1272.                     SetCol(TabStop); PutTxt(S1);
  1273.                     SetCol(TabStop+5);PutTxt(S2);
  1274.                     SetCol(TabStop+10);PutTxt(S3);
  1275.                     Inc(K,SizeOf(FixUpRec));
  1276.                 END; {While}
  1277.                            End; {IF}
  1278.                            Inc(I,SizeOf(CMapRec));
  1279.             END;  {While}
  1280.         END;   { IF CSeg Map non-Empty }
  1281.  
  1282.         IF UHTMT < UHDMT THEN    {DSeg Map non-Empty}    {.CP59}
  1283.         BEGIN
  1284.            NewTxtLine;NewTxtLine;
  1285.            BoundaryAlign(UH);
  1286.            K := NextLL;
  1287.            MapEnd := UHDMT-UHTMT;
  1288.            EndS := 0;
  1289.                    I := 0;
  1290.            While I < MapEnd DO Begin
  1291.                         FetchCONsRef(Map,UH,I);
  1292.             IF Map.MapFxJ <> 0 THEN
  1293.             BEGIN
  1294.                SetCol(1);
  1295.                IF LinesRemaining < 9 THEN NewTxtPage
  1296.                                      ELSE NewTxtLine;
  1297.                SetCol(7);
  1298.                            If Map.MapTyp = mfTVMT
  1299.                THEN PutTxt('VMT Fix-Up''s For: '
  1300.                                             +NameOfObject(UH,Map.MapOwn))
  1301.                            Else Begin
  1302.                               PutTxt('Typed CONST Fix-Up''s for: ');
  1303.                               Case Map.MapTyp Of
  1304.                                  mfXTRN: PutTxt('Linked File');
  1305.                                  mfINTF: PutTxt('_INTERFACE');
  1306.                                  mfIMPL: PutTxt('_IMPLEMENTATION');
  1307.                                  mfNEST: PutTxt('PROC('+NameOfMethod(UH,Map.MapOwn)+')');
  1308.                                  Else    PutTxt('???');
  1309.                               End
  1310.                            End;
  1311.                            NewTxtLine;NewTxtLine;
  1312.                PutTxt('Seg Load Addr = ');
  1313.                            EndS := Map.MapLod;
  1314.                PutTxt(HexW(EndS)+' --');
  1315.                            Inc(EndS,Map.MapSiz);
  1316.                PutTxt(' CONST DSeg Map Entry at ');
  1317.                PutTxt(HexW(I+UHTMT));
  1318.                SetCol(1);NewTxtLine;
  1319.                FixUpHeadings;
  1320.                K := Map.MapFxI;
  1321.                WHILE K <= Map.MapFxJ DO BEGIN
  1322.                   PageOverFlow(2,FixUpHeadings);
  1323.                               RR := PtrAdjust(UH,K);
  1324.                   FixUpIdentify(RR^,S1,S2,S3);
  1325.                   PrintBytes(UH,8,8);
  1326.                   SetCol(TabStop); PutTxt(S1);
  1327.                   SetCol(TabStop+5);PutTxt(S2);
  1328.                   SetCol(TabStop+10);PutTxt(S3);
  1329.                   Inc(K,SizeOf(FixUpRec));
  1330.                END; {WHILE}
  1331.             END; {If Fixups to print}
  1332.                         Inc(I,SizeOf(DMapRec));
  1333.                    End; {While}
  1334.         END;   { IF DSeg Map non-Empty }
  1335.         NewTxtLine;NewTxtLine;
  1336.         PutTxt('----  END OF FIX-UP LIST');
  1337.         NewTxtLine;NewTxtLine;
  1338.     END;   {IF FixUp List non-Empty}
  1339.     TabStop := SaveTab;
  1340.     BoundaryAlign(UH);
  1341.     NoteEnd;
  1342. END; {FormatFixUpList}
  1343.  
  1344. PROCEDURE DocumentUnit(P : UnitPtr);                            {.CP20}
  1345. BEGIN
  1346.     FormatHeader(P);
  1347.         NoteBegin('Analyzing Unit');
  1348.     SurveyUnit(P);                  { Cover Dictionary Entries }
  1349.         NoteEnd;
  1350.     FormatDictionary(P);        { PRINT the Dictionary     }
  1351.     FormatProcMap(P);               { PRINT the PROC Map       }
  1352.     FormatCSegMap(P);               { PRINT the CSeg Map       }
  1353.     FormatTypedConMap(P);        { PRINT the CONST Map      }
  1354.     FormatGlobalVarMap(P);        { PRINT the VAR Map        }
  1355.     FormatUnitDonorList(P);        { PRINT the Donor Unit Tab }
  1356.     FormatSourceFileList(P);    { PRINT the Source Files   }
  1357.     FormatTraceTable(P);        { PRINT the Trace Table    }
  1358.     FormatEndNonCode(P);        { PRINT separator          }
  1359.     FormatObjectCode(P);        { PRINT CODE Segments      }
  1360.     FormatDataAreas(P);        { PRINT CONST Segment Data }
  1361.     FormatFixUpList(P);        { PRINT LINKER FixUp Data  }
  1362.         PurgeUnitSurvey(P);             { Release Dictionary Cover }
  1363. END; {DocumentUnit}
  1364.  
  1365. VAR i,j : integer; P : UnitPtr; Module:String[8]; c:char;    {.CP35}
  1366.  
  1367. BEGIN       { Main Program }
  1368.     ClrScr;
  1369.     Write('Enter Name of Unit to Document: ');ReadLn(Module);
  1370.     i := WhereX; j := WhereY;
  1371.     REPEAT
  1372.         GoToXY(i,j);ClrEol;
  1373.         Write('Do You Want Dis-Assembly of Code? [Y|N] ');
  1374.         ReadLn(c);
  1375.     UNTIL UpCase(c) IN ['Y','N'];
  1376.     DisAssembly := UpCase(c) = 'Y';
  1377.     FOR I := 1 TO Length(Module) DO Module[I] := UpCase(Module[I]);
  1378.     TabStop := 36;
  1379.     InitJobUnit(Module);
  1380.     IF BufPtrJob <> Nil THEN
  1381.     BEGIN
  1382.         P := UnitPtr(BufPtrJob);
  1383.         Write('Unit Header="');
  1384.         FOR i := 0 TO 3 DO WITH P^ DO Write(UHEYE[i]);
  1385.         WriteLn('"');
  1386.         WriteLn('Unit Name="',DNamePtr(PtrAdjust(P,P^.UHUDH))^.DSymb,'"');
  1387.         OpenTxt(Module+'.LST',59,80);
  1388.         PutTxt('==============================================');   NewTxtLine;
  1389.         PutTxt('* Unit Header For: "'
  1390.         + DNamePtr(PtrAdjust(P,P^.UHUDH))^.DSymb + '"'); NewTxtLine;
  1391.         PutTxt('==============================================');   NewTxtLine;
  1392.         NextLL := 0;
  1393.         DocumentUnit(P); NewTxtPage;
  1394.         CloseTxt;
  1395.     END ELSE
  1396.         WriteLn('File "',module,'.TPU" Not Found!');
  1397.     DropJobUnit;
  1398.  
  1399. END.